COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00005 00003	! declarations and procedures
C00010 00004	! killcd
C00016 ENDMK
C⊗;
ENTRY;

BEGIN "KILLER"

REQUIRE "MACROS.SAI[PNT,HE]" SOURCE_FILE;
REQUIRE "RECORD.DEF[PNT,HE]" SOURCE_FILE;

DEFINE  KIL= 0,
	DECL=1,
      	DEL=2,
	ASG=3,
	AFX=4,
	CPY=5;

	! information about the state is saved depending on the instruction:
	  kil=not killable instruction,
	  decl=declaration instruction,
	  del=deletion instruction,
	  asg=assignment instruction,
	  afx=affix or unfix instruction,
	  cpy=merge instruction;

		! in MAINPR.SAI[PNT,HE];
EXTERNAL INTEGER $ROW;	! row in $YMTAB of last checked symbol;
EXTERNAL STRING $TRLST,$FRLST,$SCLST,$VTLST,$RTLST,$OULST;	! used for the display;
EXTERNAL RPTR(SYMBOL) PROCEDURE CHECK(STRING SYMB;INTEGER NM);
EXTERNAL RPTR(SCALAR,VECTOR,ROT,TRANS,FRAME) PROCEDURE MK_REC(INTEGER TYPE);

		! in OPERAT.SAI[PNT,HE];
EXTERNAL PROCEDURE LINKFR(RPTR(FRAME) N,D);	
EXTERNAL PROCEDURE UNLINK(RPTR(FRAME) N);
! declarations and procedures;

RCLASS SAVED (INTEGER ADDR,TYPE;RPTR(SYMBOL)SYMBOL;RANY OBJECT;
	RPTR(FRAME)DAD;INTEGER LINK;RPTR(SAVED)NEXT);

RPTR(SAVED) KILL;

DEFINE #NW = -1;			
DEFINE #NWFR= -2;

INTERNAL PROCEDURE SAVNEW(RPTR(SYMBOL)EL;INTEGER TYPE);
	BEGIN
	RPTR(SAVED)TEMP;
	TEMP←NEW_RECORD(SAVED);
	SAVED:ADDR[TEMP]←$ENTRY[TYPE]-1;	! entry in $YMTAB(last created symb);
	SAVED:TYPE[TEMP]←IF TYPE=#FR THEN #NWFR ELSE #NW;
	SAVED:OBJECT[TEMP]←SYMBOL:OBJECT[EL];	! se e` nuovo conservo il ptr, se no;
	SAVED:NEXT[TEMP]←KILL;			! conservo il ptr al record temporaneo;
	KILL←TEMP;
	END;

INTERNAL PROCEDURE INIKIL;
	BEGIN
	KILL←NULL_RECORD;
	END;

	! returns a rptr to a new record of class type. The record is not inserted
	  in $YMTAB (temporary record). The values of the record EL are copied into;

RANY PROCEDURE SAVREC(INTEGER TYPE;RPTR(SYMBOL)EL);
	BEGIN
	RANY TEMP,OBJ;
	OBJ←SYMBOL:OBJECT[EL];
	IF TYPE=#SC
	   THEN BEGIN
		TEMP←MK_REC(#SC);SCALAR:VALUE[TEMP]←SCALAR:VALUE[OBJ];
		END
	ELSE IF TYPE=#VT
	   THEN BEGIN
		TEMP←MK_REC(#VT);VECTOR:XC[TEMP]←VECTOR:XC[OBJ];
		VECTOR:YC[TEMP]←VECTOR:YC[OBJ];VECTOR:ZC[TEMP]←VECTOR:ZC[OBJ];
		END
	ELSE IF TYPE=#RT 
	   THEN BEGIN
		TEMP←MK_REC(#TR);
		ARRTRAN(TRANS:XF[TEMP],ROT:XF[OBJ]);
		END
	ELSE IF TYPE=#TR 
	   THEN BEGIN
		TEMP←MK_REC(#TR);
		ARRTRAN(TRANS:XF[TEMP],TRANS:XF[OBJ]);
		END
	ELSE  IF TYPE=#FR
	   THEN	BEGIN
		TEMP←MK_REC(#TR);
		ARRTRAN(TRANS:XF[TEMP],FRAME:XF[OBJ]);
		END;
	RETURN(TEMP);
	END;

INTERNAL PROCEDURE SAVOLD(RPTR(SYMBOL)EL;INTEGER TYPE);
	BEGIN
	RPTR(SAVED)TEMP;RANY OLDPTR;
	TEMP←NEW_RECORD(SAVED);
	SAVED:ADDR[TEMP]←$ROW;
	SAVED:TYPE[TEMP]←TYPE;
	SAVED:SYMBOL[TEMP]←EL;
	OLDPTR←SAVREC(TYPE,EL);			! creates a new record and copies valus;
	SAVED:OBJECT[TEMP]←OLDPTR;
	SAVED:NEXT[TEMP]←KILL;
	KILL←TEMP;
	CASE TYPE OF
	     BEGIN "CASE"
	[#SC]	$SCLST←NULL;
	[#VT]	$VTLST←NULL;
	[#RT]	$RTLST←NULL;
	[#FR]   $FRLST←NULL;
	[#TR]   $TRLST←NULL
	     END "CASE";
	END;

INTERNAL PROCEDURE SAVTRE(RPTR(SYMBOL)EL);
	BEGIN
	RPTR(FRAME)FRN;
	FRN←SYMBOL:OBJECT[EL];
	SAVOLD(EL,#FR);			! saves the values of the frame;
	SAVED:DAD[KILL]←FRAME:DAD[FRN];		! the pointer to its dad;
	SAVED:LINK[KILL]←FRAME:HOWLINKED[FRN]; 	! the kind of affixment;
	END;

INTERNAL PROCEDURE SAVFR(RPTR(FRAME) N);
	BEGIN
	RPTR(SYMBOL)EL;
	! if there are some #RGDLK, finds the pointer to the first frame
	  not rigidly affixed, and saves its values;
	EL←CHECK(FRAME:PNAME[N],#FR);
	SAVOLD(EL,#FR);
	END;
! killcd;

PROCEDURE TREE_RECOVER(RPTR(SAVED) TEMP);
	BEGIN
	LINKFR(symbol:object[SAVED:symbol[TEMP]],SAVED:DAD[TEMP]);	! links the frames;
	FRAME:HOWLINKED[symbol:object[SAVED:symbol[TEMP]]]←SAVED:LINK[TEMP];
	END;

	! kills $LAST instruction: only declarations, deletions, assignments
	  and tree operations can be killed. The value of $LAST indicates the
	  type of $LAST executed instruction;

INTERNAL PROCEDURE KILLCD(INTEGER LAST);
	BEGIN
	RPTR(SAVED)TEMP;
	CASE LAST OF
	BEGIN "CASE"
	[KIL]   PRINT("sorry...I can't ",CRLF);		! unkillable instruction;
	[DECL]  BEGIN
		TEMP←KILL;
		WHILE TEMP DO		! declaration;
		      BEGIN
		! deletes the new created symbols, the frames are unlinked;
		      $YMTAB[SAVED:ADDR[TEMP]]←NULL_RECORD;
		      IF SAVED:TYPE[TEMP]=#NWFR 
			 THEN UNLINK(SAVED:OBJECT[TEMP]);
		      TEMP←SAVED:NEXT[TEMP];
		      END;
		$SCLST←$VTLST←$RTLST←$TRLST←$FRLST←NULL;
		END;
	[DEL]   BEGIN 
		BOOLEAN TREE;		! deletion;
		TEMP←KILL;
		WHILE TEMP DO
		      BEGIN
		! inserts symbols deleted and restores values and tree structure;
		      $YMTAB[SAVED:ADDR[TEMP]]←SAVED:SYMBOL[TEMP];
		      IF SAVED:TYPE[TEMP]=#FR THEN TREE_RECOVER(TEMP);
		      TEMP←SAVED:NEXT[TEMP];
		      END;
		$SCLST←$VTLST←$RTLST←$TRLST←$FRLST←NULL;
		END;
	[ASG]   BEGIN				! assignment;
		INTEGER TYPE;RPTR(SYMBOL)EL;RANY OBJ,OLD;RPTR(SAVED)TEMP;
		TEMP←KILL;
		WHILE TEMP DO
			BEGIN
		! if symbol is a new defined one it is simply deleted, otherwise
		  old values and tree structure are restored ;
			TYPE←SAVED:TYPE[TEMP];
			EL←SAVED:SYMBOL[TEMP];
			OLD←SAVED:OBJECT[TEMP];
			$YMTAB[SAVED:ADDR[TEMP]]←EL;
			IF TYPE≠#NW
			   THEN IF TYPE=#NWFR
				   THEN UNLINK(OLD)
				ELSE 
				IF TYPE=#SC OR TYPE=#VT
				   THEN SYMBOL:OBJECT[EL]←OLD
				ELSE IF TYPE=#RT
				   THEN ARRTRAN(ROT:XF[SYMBOL:OBJECT[EL]],
						TRANS:XF[OLD])
				ELSE IF TYPE=#TR
				   THEN ARRTRAN(TRANS:XF[SYMBOL:OBJECT[EL]],
						TRANS:XF[OLD])
				ELSE ARRTRAN(FRAME:XF[SYMBOL:OBJECT[EL]],
	         				TRANS:XF[OLD]);
			TEMP←SAVED:NEXT[TEMP];
			END;
		$SCLST←$VTLST←$RTLST←$TRLST←$FRLST←NULL;
		END;

	[AFX]   BEGIN 				! affix/unfix;
		! restores previous structure: if a new frame has been created
		  it is unlinked and deleted, otherwise previous values and 
		  structure are restored;
		IF TEMP←SAVED:NEXT[KILL]
		   THEN BEGIN			! a new frame was created;
			IF SAVED:TYPE[TEMP]=#NWFR
			   THEN BEGIN
				$YMTAB[SAVED:ADDR[TEMP]]←NULL_RECORD;
				UNLINK(SAVED:OBJECT[TEMP]);
				IF TEMP←SAVED:NEXT[TEMP]
				   THEN	BEGIN		! that was a trans;
					$YMTAB[SAVED:ADDR[TEMP]]←SAVED:SYMBOL[TEMP];
					ARRTRAN(TRANS:XF[SYMBOL:OBJECT[SAVED:SYMBOL[TEMP]]],
						TRANS:XF[SAVED:OBJECT[TEMP]]);
					$TRLST←NULL;
					END;
				END;
			END
		   ELSE BEGIN
			$YMTAB[SAVED:ADDR[KILL]]←SAVED:SYMBOL[KILL];
			ARRTRAN(FRAME:XF[SYMBOL:OBJECT[SAVED:SYMBOL[KILL]]],
				TRANS:XF[SAVED:OBJECT[KILL]]);
			TREE_RECOVER(KILL);
			END;
		$FRLST←NULL;
		END;
	[CPY]  BEGIN
		TEMP←KILL;
		WHILE TEMP DO		! merge;
			BEGIN  
			! unlinks and deletes new frames;
		 	UNLINK(SAVED:OBJECT[TEMP]);
	 		$YMTAB[SAVED:ADDR[TEMP]]←NULL_RECORD;
			TEMP←SAVED:NEXT[TEMP];
		      END;
		END
	END "CASE";
	END;

END "KILLER";